Modeling Runners’ Times in the Cherry Blossom Race - Case Study Unit 8

Cory Adams, Chris Boomhower, Alexandra Fisher, Alex Frye

MSDS 7333, October 25, 2017

NOTE: Answering Q.10: We have seen that the 1999 runners were typically older than the 2012 runners. Compare the age distribution of the runners across all 14 years of the races. Use quantile- quantile plots, boxplots, and density curves to make your comparisons. How do the distributions change over the years? Was it a gradual change?

Abstract

In this case study, race results for the Cherry Blossom Ten Mile Run from 1999 to 2012 are used to study how people’s physical performance changes with age [1]. The focus of the study involves scraping the Web for free and publicly published data and then getting that data into the correct format. In order to investigate how age distributions change over the years, age distribution for all runners across 14 years is compared; however, what information is recorded and how the data is formatted changes each year so close attention is paid first to formatting the data. The R language is leveraged to appropriately format the data via statistical analysis and examining summary statistics and plots. Following data acquisition and successfully reading tables of race results into R, results are analyzed and compared using quantile-quantile plots, boxplots, and density curves. In this way, we are able to visualize the data for tens of thousands of observations to explore the performance-age relationship. [insert results / final outcome]

Introduction

This case study was undertaken in order to explore and shed light on the complex relationship between a person’s age and physical performance. Data used comes from the infamous Credit Union Cherry Blossom race. The Cherry Blossom Ten Mile Run is held every year during the month of April in Washington, D.C. when cherry blossom trees are said to bloom. Race results for the Cherry Blossom Ten Mile Run are available to the public online at http://www.cherryblossom.org/ and currently include annual results spanning from 1999 to 2012 (14 years in total). The race began in 1973 and has since grown by tens of thousands of runners to 17,000 entries in 2012 with ages ranging from 9 to 89. In fact, the race has been in such high demand that runners are chosen via a lottery system to enter the race. Because of the enormous amount of observations there is a clear abundance of information that can be used as a resource for investigating the performance-age relationship.

To that end, while this information is free and available to the public, what information is reported and how the data is formatted changes each year, presenting a challenge that must first be overcome before conducting further analysis. Therefore, after data clean up is performed and race results data tables are read into R, we then turn our focus to the age distribution of runners across all 14 years of the races, as we have seen that the 1999 runners were typically older than the 2012 runners [1]. This is achieved by creating visual representations of the data through QQ-plots, boxplots, and density curves. These visualizations are important for gaining deeper insights by seeing how fast or gradual changes are over time, as well as any outliers or subtle trends. For the purposes of this case study, only these three categories of plots are considered for only male runners and compared for a final analysis to ultimately determine how the distributions change over the years and if the changes was gradual.

Methods

The steps used for this analysis were: 1) data acquistion; 2) Additional Data cleanup for outlier removal; 3) density curves analysis; 4) quantile-quantile plots analysis; and 5) boxplots analysis.

Note that code used includes modified versions of R code function examples found in Data Science in R: A Case Studies Approach to Computational Reasoning and Problem Solving, Chapter 2, pages 47-100 [1].

Results

Data Acquisition

To begin, we utilized methods provided in the Data Science in R text to load male runners from 1999 to 2012. As the purpose of this analysis is to research this data post load, we have excluded the scraping process from this analysis and the data is loaded external to the notebook in the DataExtractAndClean.R file allowing us to focus on our analysis of age distributions.

Data Cleanup for Outlier Removal

Before beginning our analysis of age distributions, we have some preliminary data cleanup to perform on multiple scenarios, as this analysis is meant to represent the general population less outliers. First, there is 1 observation which appears to contain an outlier for its run-time; a 70 year old with a run-time of 1.5 which is likely either due to a non-starter or a data entry error.

Second, we identify 21 observations which have null values for age. These records are unable to be visualized for age distributions, and thus removed as well.

Lastly, we identify 10 observations with an age less than 10. Although there could be a young child in the run, there are several of these values with an age between 0 and 4, leaving us untrusting of the other three values remaining for 8 and 9 year olds. Due to this, we have decide to cut off the age lower limit at 10 years old to describe general population.

cbMenSub = cbMen[cbMen$runTime > 30 & !is.na(cbMen$age) & cbMen$age >= 10, ]

With these few outliers removed, we transform from 70070 to 70038 observations. We are now ready to move forward with our analysis of age distributions amongst each year.

Density Curve

To begin our density curve analysis, we first were interested in the overall distribution of age in the population across all years. Across all 14 years, the mean age is 38.611311, whereas the median age is 37. This suggests, since the mean value is larger than the median, that we have a slightly right-skewed distribution. Breaking age into bins of decade groups (10-20, 20-30,…,70,80, etc.), we are able to visualize the overall distribution of age. These bin counts help further these findings, with our most frequency bin including ages 30-40, the same identified for mean and median age. The distribution of bin counts also further supports the right-skew distribution as there is a slightly longer tail from 40-90 in comparison to that between 10-30.

ageCat = cut(cbMenSub$age, breaks = c(seq(10, 80, 10), 90))
bins=as.data.frame(table(ageCat))
bins.p <-ggplot(bins, aes(x=ageCat, y=Freq)) + geom_bar(stat="identity")
bins.p<-ggplotly(bins.p)
bins.p

To further this analysis, we are interested to see how age distribution has changed over the many years this race has been conducted. Below is a stacked density plot, providing a single curve for every year. Noteworthy to mention, the plot provided is rendered with plotly, allowing interactive hover values, zoom controls, and toggling of years to display by clicking on the legend. Before targetting specific years, there appears to be a notable decrease in mean age from 1999 to recent years. Additionally, earlier years appear to have a much more normal distribution in age than that of recent years.

By clicking on individual legend years {1999, 2004, 2008, 2012}, we may de-clutter the visual for further research into these findings on a wide spread of year runs. The mean age may be seen in the table below.

Year	Mean Age
1999	40.3352148
2004	39.3128008
2008	37.7835732
2012	37.7528856

As was originally gleamed, ages steadily decrease from a mean of 40.3352148 to 37.7528856 years old. as the density curves also suggest, we observe the curves shift positions from right to left and density skewness elongate as we progress from early to recent years. These findings confirm our original observations, indicating that the core demographic for participating runners are decreasing year after year. We speculate this decrease will slow down moving forward, just as was seen from 2008 to 2012, with only a 0.0306877 difference in mean age in those years since participants under 20 have been insignificant across all years of the race. Although the mean distribution is shifting left, it is apparent that participation amongst the age groups above 40 have not significantly decreased. Because of this, we begin seeing the right-skew distribution increase in the most recent years of the race.

# Subset in order to color by year
cbMensPlot <- cbMenSub
cbMensPlot$year <- as.character(cbMensPlot$year)
age.d = ggplot(cbMensPlot, aes(age, color = year)) + geom_density() + scale_x_continuous(breaks = pretty(cbMensPlot$age, n = 10))
age.d = ggplotly(age.d) #Convert to plotly version
age.d

Quantile-Quantile Plots

Next in our analysis, we are interested to further build our case on normality of age distributions across the many years of the race. To do this, we decide to produce a Quantile-Quantile Plot (QQPlot) to assess our data’s quantiles against a theoretical normal distribution quantile. If our data poses as perfectly normal, we would see a straight line. The more our scatter varies from the ideal line, the further from normality is the distribution.

In efforts to create an interactive plotly visualization for these QQPlots as was done for density curves, the rendering was overbearing in terms of performance. Due to these issues, the stacked (static) ggplot visual is provided, however very difficult to gleam insights from. It is apparent that several of these years have normality problems, however very difficult to understand which years the plot references.

# calculate the normal theoretical quantiles per group
cbMensPlotQQ <- ddply(.data = cbMensPlot, .variables = .(year),
                      function(dsub){
                          q <- qqnorm(dsub$age, plot = FALSE)
                          dsub$xq <- q$x
                          dsub
                      })
age.qq = ggplot(data = cbMensPlotQQ, aes(x = xq, y = age, color = year)) +
                geom_point() +
                geom_smooth(method = "lm", se = FALSE) +
                xlab("Normal Theoretical Quantiles") +
                ylab("Normal Data Quantiles")
#age.qq = ggplotly(age.qq)
age.qq

To mitigate these issues, we build ggplot rendering of each year individually below in order to assess individually in comparison to the others. Although none of these plots provide us with a “perfect” line representing normality, we can assert that over time the distributions for age become less normal. Looking at the same years {1999,2004, 2008, 2012} as was done previously, we see very strong normality between ~30-60 years of age in the 1999 race. Moving towards 2004, we begin to see the scatter dip below the normality line, and a larger variation under 30 than was seen before. In 2008, we once again see the scatter dropping below the normality line, and increasing variance in both ages under 30 and those above 50 years old. Finally, in 2012, we see variation amongst the majority of the scatter and the normality line. These results help to further support those findings provided from density curves, in that normality in age distributions has began to shift. In recent years, we begin to have a skewed distribution, likely caused by the increased participation of the younger individuals.

plot.list <- list()
i = 1
#color.vect <- c('#D32F2F', '#C2185B', '#7B1FA2', '#512DA8', '#303F9F', '#1976D2', '#0288D1',
#                '#0097A7', '#00796B', '#388E3C', '#689F38', '#AFB42B', '#FBC02D', '#FFA000')
for(yr in unique(cbMensPlot$year)){
    cbMensPlotQQ <- ddply(.data = subset(cbMensPlot, cbMensPlot$year == yr), .variables = .(year),
                          function(dsub){
                              q <- qqnorm(dsub$age, plot = FALSE)
                              dsub$xq <- q$x
                              dsub
                          })
    
    age.qq = ggplot(data = cbMensPlotQQ, aes(x = xq, y = age, color = year)) +
                    geom_point() +
                    geom_smooth(method = "lm", se = FALSE) +
                    xlab("Normal Theoretical Quantiles") +
                    ylab("Normal Data Quantiles")
    
    #ggplot doesn't like to evaluate vector indexed contents so having to explicitly write color values line-by-line
    if(i==1) plot.list[[i]] <- age.qq + scale_color_manual(values='#D32F2F')
    if(i==2) plot.list[[i]] <- age.qq + scale_color_manual(values='#C2185B')
    if(i==3) plot.list[[i]] <- age.qq + scale_color_manual(values='#7B1FA2')
    if(i==4) plot.list[[i]] <- age.qq + scale_color_manual(values='#512DA8')
    if(i==5) plot.list[[i]] <- age.qq + scale_color_manual(values='#303F9F')
    if(i==6) plot.list[[i]] <- age.qq + scale_color_manual(values='#1976D2')
    if(i==7) plot.list[[i]] <- age.qq + scale_color_manual(values='#0288D1')
    if(i==8) plot.list[[i]] <- age.qq + scale_color_manual(values='#0097A7')
    if(i==9) plot.list[[i]] <- age.qq + scale_color_manual(values='#00796B')
    if(i==10) plot.list[[i]] <- age.qq + scale_color_manual(values='#388E3C')
    if(i==11) plot.list[[i]] <- age.qq + scale_color_manual(values='#689F38')
    if(i==12) plot.list[[i]] <- age.qq + scale_color_manual(values='#AFB42B')
    if(i==13) plot.list[[i]] <- age.qq + scale_color_manual(values='#FBC02D')
    if(i==14) plot.list[[i]] <- age.qq + scale_color_manual(values='#FFA000')
    
    #plot.list[[i]] <- age.qq + scale_color_manual(values=eval(as.character(color.vect[i])))
    i = i + 1
}
grid.arrange(plot.list[[1]], 
             plot.list[[2]],
             plot.list[[3]],
             plot.list[[4]],
             plot.list[[5]],
             plot.list[[6]],
             plot.list[[7]],
             plot.list[[8]],
             plot.list[[9]],
             plot.list[[10]],
             plot.list[[11]],
             plot.list[[12]],
             plot.list[[13]],
             plot.list[[14]], ncol=2)

Boxplots

After cleaning up the data and displaying it as a boxplot (below) we can better analyze the age and year variables. While there is not a significant difference between the second and third quartiles between 1999 and 2012, it is clear the median age for runners in 2012 is lower than 1999. Also, a quick look at the boxplots shows the median age value gradually decreasing over time, with 2011 as the only exception. A closer look at the boxplot statistics shows the median age of runners in 1999 was 40, while the median age of runner in 2012 was 36. Another interesting metric is the number of observations also increased each year from 3189 in 1999 to 7191 in 2012. The data, as shown in the boxplot, does not have any significant outliers which leads to the conclusion the data is reliable and shows a gradual decline in the age of runners over time.

# str(cbMenSub)
# 
# bp <- boxplot(cbMenSub$age ~ cbMenSub$year, ylab = "Age", xlab = "Year", col = c
# ("red","sienna","palevioletred1","royalblue2","cadetblue","burlywood3","chartreuse", 
# "cyan4","darkgoldenrod","darkorange1","firebrick","dodgerblue", "forestgreen"), las = 2)
# bp
# bp$stats[3,]
bp.p <- ggplot(cbMensPlot, aes(x=year, y=age, fill=year)) + geom_boxplot() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + scale_y_continuous(breaks = pretty(cbMensPlot$age, n = 10))+
    stat_summary(fun.y=mean, geom="point", shape=5, size=4)
bp.p <- ggplotly(bp.p)
bp.p

Discussion and Future Works

References

[1] D. Lang and D. Nolan, Data Science in R: A Case Studies Approach to Computation Reasoning and Problem Solving. New York, New York: CRC Press.